HyperLib 1997 Winter - Disc 1/HYPERLIB-1997-Winter-CD1.ISO.7z/HYPERLIB-1997-Winter-CD1.ISO/オンラインウェア/PRG/ICProgKit 1.3.sit/ICProgKit1.3/Examples/SpaceAliens/SpaceAliens.p

Text File | 1996-07-30 | 10KB | 319 lines

program SpaceAliens;
    (* Space Aliens Ate My Icons *)
    (* A drag and drop utility to fix the type and *)
    (* creator of any dropped on file based on its *)
    (* extension and the database of extension mappings *)
    (* provided by Internet Config. *)

    uses
        (* Basic system units.  Most of these are *)
        (* automatically included under Think, but *)
        (* they need to be explicitlt stated with CodeWarrior *)
        Resources, Fonts, Windows, QuickDraw, Menus, TextEdit, Dialogs, Memory, Types,
        Errors, Files, Finder, TextUtils, OSUtils, Processes, GestaltEqu, Dialogs,

        (* standard system units needed to do AppleEvents *)
        (* remember that Think Pascal automatically uses *)
        (* most of the base operating system *)
        EPPC, AppleEvents, Events,

        (* standard IC units *)
        ICTypes, ICAPI, ICKeys;

(* ***** Standard Subroutines ***** *)

    function ICGetPrefStr (inst: ICInstance; key: Str255; var attr: ICAttr; var str: Str255): ICError;
        var
            err: ICError;
            size: longint;
    begin
        size := 256;
        err := ICGetPref(inst, key, attr, @str, size);
        if err <> noErr then begin
            str := '';
        end; (* if *)
        ICGetPrefStr := err;
    end; (* ICGetPrefStr *)

    function GotRequiredParams (theAppleEvent: AppleEvent): ICError;
        (* standard AppleEvent routine copied out of NIM:IAC *)
        var
            typeCode: DescType;
            actualSize: Size;
            err: ICError;
    begin
        err := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, typeCode, nil, 0, actualSize);
        if err = errAEDescNotFound then begin
            GotRequiredParams := noErr;
        end
        else if err = noErr then begin
            GotRequiredParams := errAEEventNotHandled;
        end
        else begin
            GotRequiredParams := err;
        end; (* if *)
    end; (* GotRequiredParams *)

(* ***** Global Declarations ***** *)

    const
        my_creator = 'SA8I';
                    (* the application signature *)
    var
        quit_now: boolean;
                    (* set to true when you want main loop to quit *)
        instance: ICInstance;
                    (* global connection to IC *)
        mappings: Handle;
                    (* the mapping preference as returned by IC *)

(* ***** Do The Hard Stuff ***** *)

    function ProcessDocument (fss: FSSpec): ICError;
        (* this is the core of the program *)
        (* the fss parameter is a file whose extension *)
        (* we'll look up in the IC database *)
        (* mappings global variable is already set up *)
        (* to contain that database *)
        var
            err: ICError;
            count: longint;
                        (* total number of entries in database *)
            i: longint;
                        (* indexes over the database entries *)
            this: ICMapEntry;
                        (* an unpacked element of the *)
                        (* mappings database, used while stepping *)
                        (* through database *)
            entry: ICMapEntry;
                        (* a mappings database element *)
                        (* used to record the best match *)
            longest_len: integer;
                        (* longest extension we've found so far *)
            posndx: longint;
                        (* the index into the mappings database *)
            info: FInfo;
                        (* temporary for changing type and creator *)
    begin
        (* count the total number of entries *)
        err := ICCountMapEntries(instance, mappings, count);
        if err <> noErr then begin
            count := 0;
        end; (* if *)
        (* loop through the entries *)
        (* looking for the longest match *)
        longest_len := 0;
        posndx := 0;
        for i := 1 to count do begin
            (* ICMGetEntry gets the entry from mappings *)
            (* that starts at posndx *)
            (* and puts it into the entry record *)
            if ICGetMapEntry(instance, mappings, posndx, this) = noErr then begin
                (* increment posndx so that we get the next *)
                (* entry the next time around the loop *)
                posndx := posndx + this.total_length;
                (* the entry matches if *)
                (* not_incoming flag bit is clear *)
                (* it's longer than the previous max *)
                (* it's longer than the file name *)
                (* it matches the last N chars of the filename *)
                if not btst(this.flags, ICmap_not_incoming_bit) & (length(this.extension) > longest_len) & (length(this.extension) < length(fss.name)) & (IUEqualString(copy(fss.name,  length(fss.name) - length(this.extension) +1, length(fss.name)), this.extension) = 0) then begin
                    (* record the new longest entry *)
                    entry := this;
                    longest_len := length(this.extension);
                end; (* if *)
            end; (* if *)
        end; (* for *)

        (* if we found any matches then *)
        (* set the file type and creator appropriately *)
        if longest_len > 0 then begin
            err := HGetFInfo(fss.vRefNum, fss.parID, fss.name, info);
            if err = noErr then begin
                info.fdCreator := entry.file_creator;
                info.fdType := entry.file_type;
                err := HSetFInfo(fss.vRefNum, fss.parID, fss.name, info);
            end; (* if *)
        end
        else begin
            err := noErr;
        end; (* if *)

        quit_now := true;
        ProcessDocument := err;
    end; (* ProcessDocument *)

(* ***** AppleEvent Handlers ***** *)

    function HandleOpenApplication (var theAppleEvent: AppleEvent; var reply: AppleEvent; refcon: longint): OSErr;
        (* the 'oapp' event handler, displays the about box *)
        (* should most probably only do this if we're in *)
        (* the foreground but that's just too complicated *)
        (* for this example *)
        var
            err: ICError;
            email_address: Str255;
            junk_attr: longint;
            junk: integer;
            junk_icerr: ICError;
    begin
        (* debugger; *)
        err := GotRequiredParams(theAppleEvent);
        if err = noErr then begin
            junk_icerr := ICGetPrefStr(instance, kICEmail, junk_attr, email_address);
            ParamText(email_address, '', '', '');
            junk := Alert(128, nil);
            quit_now := true;
        end; (* if *)
        HandleOpenApplication := err;
    end; (* HandleOpenApplication *)

    function HandleOpenDocuments (var theAppleEvent: AppleEvent;var  reply: AppleEvent; refcon: longint): OSErr;
        (* a fairly standard 'odoc' event handler *)
        (* gets the document list, counts the items in it *)
        (* gets the FSSpec for each document and calls *)
        (* ProcessDocument on it *)
        var
            fss: FSSpec;
            doc_list: AEDescList;
            index, item_count: longint;
            junk_size: Size;
            junk_keyword: AEKeyword;
            junk_type: descType;
            err, junk: ICError;
    begin
        err := AEGetParamDesc(theAppleEvent, keyDirectObject, typeAEList, doc_list);
        if err = noErr then begin
            err := GotRequiredParams(theAppleEvent);
            if err = noErr then begin
                err := AECountItems(doc_list, item_count);
            end
            else begin
                item_count := 0;
            end; (* if *)
            for index := 1 to item_count do begin
                if err = noErr then begin
                    err := AEGetNthPtr(doc_list, index, typeFSS, junk_keyword, junk_type, @fss, sizeof(fss), junk_size);
                    if err = noErr then begin
                        err := ProcessDocument(fss);
                    end; (* if *)
                end; (* if *)
            end; (* for *)
            junk := AEDisposeDesc(doc_list);
        end; (* if *)
        HandleOpenDocuments := err;
    end; (* HandleOpenDocuments *)

    function HandleQuit (var theAppleEvent: AppleEvent;var reply: AppleEvent; refcon: longint): OSErr;
        (* a fairly standard 'quit' event handler *)
        (* sets quit_now so that the main event loop quits *)
        var
            err: ICError;
    begin
        err := GotRequiredParams(theAppleEvent);
        if err = noErr then begin
            quit_now := true;
        end; (* if *)
        HandleQuit := err;
    end; (* HandleQuit *)

{$IFC not GENERATINGPOWERPC}
    function StackPtr: longInt;
    inline
        $2E8F;
{$ENDC}

    var
        junkbool: boolean;
        event: EventRecord;
        err: ICError;
        junk: ICError;
        response: longint;
        attr: longint;
        i : longint;
begin
    (* Lots of Initializing stuff. *)
    InitGraf(@qd.thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(nil);
    (* Only a concern if you are compiling for 68K.*)
{$IFC not GENERATINGPOWERPC}
    SetApplLimit(Ptr(StackPtr - 32768));
{$ENDC}
    MaxApplZone;
    for i := 1 to 3 do begin
        MoreMasters;
    end;

    (* First check for System 7.  OK, so we're supposed *)
    (* to test for functionality but this is example *)
    (* code. *)
    if (Gestalt(gestaltSystemVersion, response) <> noErr) | (response < $700) then begin
        ExitToShell;
    end; (* if *)

    (* Now install our AppleEvent handles. *)
    err := AEInstallEventHandler(kCoreEventClass, kAEOpenApplication, @HandleOpenApplication, 0, false);
    if err = noErr then begin
        err := AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments, @HandleOpenDocuments, 0, false);
    end; (* if *)
    if err = noErr then begin
        err := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @HandleQuit, 0, false);
    end; (* if *)

    (* startup Internet Config *)
    if err = noErr then begin
        err := ICStart(instance, my_creator);
        if err = noErr then begin
            err := ICFindConfigFile(instance, 0, nil);
        end; (* if *)

    (* fetch the mappings preference *)
        if err = noErr then begin
            err := ICGetPrefHandle(instance, kICMapping, attr, mappings);
        end; (* if *)

    (* enter main loop *)
        if err = noErr then begin
            quit_now := false;
            while not quit_now do begin
                junkbool := WaitNextEvent(everyEvent, event, maxlongint, nil);
                case event.what of
                    keyDown:
                        quit_now := true;
                    kHighLevelEvent:
                        junk := AEProcessAppleEvent(event);
                    otherwise
                        ;
                end; (* case *)
            end; (* while *)
        end; (* if *)

        (* shut down IC, only if we successfully started it *)
        junk := ICStop(instance);
    end; (* if *)

    (* beep if we get any errors*)
    (* sophisticated error handling this is not *)
    (* a good place to put a breakpoint this is *)
    if err <> noErr then begin
        SysBeep(10);
    end; (* if *)
end. (* SpaceAliens *)


(*
Updated from v1.0.1:

Changed to work with CW.

+ Added Initialization code.
+ Listed all System Units used by the program.
+ Updated the 'copy' procedure used in ProcessDocument to
reflect the fact that CW returns 0 if the integer parameters
are out of range, rather than trying for a best fit as in Think.
+ Removed the SIZE resource from SpaceAliens.rsrc: this is generated by CW.
*)